TidyTuesday:PowerLifting

DataSet Github Page:https://github.com/rfordatascience/tidytuesday/tree/master/data/2019/2019-10-08

Usecase replication Github Page

https://connorrothschild.github.io/tidytuesday/2019-10-08/index

#install.packages("ggplot2")
#install.packages("tidyverse")
#install.packages("cr")
#install.packages("flexdashboard")
library(flexdashboard)
library(ggplot2)
library(tidyverse)
library(tidyr)
#library(cr)

#set_cr_theme(font = "lato")

load the data

# df <- readr::read_csv("openpowerlifting-2019-09-20.csv")
# 
# df_clean <- df %>% 
#   janitor::clean_names()
# 
# ipf_lifts <- df_clean %>% 
#   select(name:weight_class_kg, starts_with("best"), place, date, federation, meet_name)  %>% 
#   filter(!is.na(date)) %>% 
#   filter(federation == "IPF")

ipf_lifts <- read_csv("data/ipf_lifts.csv")
## Parsed with column specification:
## cols(
##   name = col_character(),
##   sex = col_character(),
##   event = col_character(),
##   equipment = col_character(),
##   age = col_double(),
##   age_class = col_character(),
##   division = col_character(),
##   bodyweight_kg = col_double(),
##   weight_class_kg = col_character(),
##   best3squat_kg = col_double(),
##   best3bench_kg = col_double(),
##   best3deadlift_kg = col_double(),
##   place = col_character(),
##   date = col_date(format = ""),
##   federation = col_character(),
##   meet_name = col_character()
## )
# run the glimpse() function
glimpse(ipf_lifts)
## Observations: 41,152
## Variables: 16
## $ name             <chr> "Hiroyuki Isagawa", "David Mannering", "Eddy Pe…
## $ sex              <chr> "M", "M", "M", "M", "M", "M", "M", "M", "M", "M…
## $ event            <chr> "SBD", "SBD", "SBD", "SBD", "SBD", "SBD", "SBD"…
## $ equipment        <chr> "Single-ply", "Single-ply", "Single-ply", "Sing…
## $ age              <dbl> NA, 24.0, 35.5, 19.5, NA, NA, 32.5, 31.5, NA, N…
## $ age_class        <chr> NA, "24-34", "35-39", "20-23", NA, NA, "24-34",…
## $ division         <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
## $ bodyweight_kg    <dbl> 67.5, 67.5, 67.5, 67.5, 67.5, 67.5, 67.5, 90.0,…
## $ weight_class_kg  <chr> "67.5", "67.5", "67.5", "67.5", "67.5", "67.5",…
## $ best3squat_kg    <dbl> 205.0, 225.0, 245.0, 195.0, 240.0, 200.0, 220.0…
## $ best3bench_kg    <dbl> 140.0, 132.5, 157.5, 110.0, 140.0, 100.0, 140.0…
## $ best3deadlift_kg <dbl> 225.0, 235.0, 270.0, 240.0, 215.0, 230.0, 235.0…
## $ place            <chr> "1", "2", "3", "4", "5", "6", "7", "1", "2", "2…
## $ date             <date> 1985-08-03, 1985-08-03, 1985-08-03, 1985-08-03…
## $ federation       <chr> "IPF", "IPF", "IPF", "IPF", "IPF", "IPF", "IPF"…
## $ meet_name        <chr> "World Games", "World Games", "World Games", "W…

Clean ipf_lifts, and reshape the three lifts into one column

#install.packages("lubridate")

library(lubridate)
## 
## Attaching package: 'lubridate'
## The following object is masked from 'package:base':
## 
##     date
ipf_lifts <- ipf_lifts %>% 
  mutate(year = lubridate::year(date))

ipf_lifts_reshape <- ipf_lifts %>% 
  tidyr::pivot_longer(cols = c("best3squat_kg", "best3bench_kg", "best3deadlift_kg"), names_to = "lift") %>% 
  select(name, sex, year, lift, value)

This visualization is concerned with the heaviest lifts from each year

ipf_lifts_maxes <- ipf_lifts_reshape %>% 
  group_by(year, sex, lift) %>% 
  top_n(1, value) %>% 
  ungroup %>% 
  distinct(year, lift, value, .keep_all = TRUE)

In order to construct a dumbbell plot, we need both male and female observations in the same row.

max_pivot <- ipf_lifts_maxes %>% 
  spread(sex, value)

Now construct a dataframe for each sex and join them:

male_lifts <- max_pivot %>% 
  select(-name) %>% 
  filter(!is.na(M)) %>% 
  group_by(year, lift) %>% 
  summarise(male = mean(M))

female_lifts <- max_pivot %>% 
  select(-name) %>% 
  filter(!is.na(`F`)) %>% 
  group_by(year, lift) %>% 
  summarise(female = mean(`F`))

max_lifts <- merge(male_lifts, female_lifts)

max_lifts_final <- max_lifts %>% 
  group_by(year, lift) %>% 
  mutate(diff = male - female)

Construct the visualization.

First, a static viz

#install.packages("devtools")
#devtools::install_github("clauswilke/ggtext")
#devtools::install_github("connorrothschild/tpltheme")
library(tpltheme)
## 
## Attaching package: 'tpltheme'
## The following objects are masked from 'package:ggplot2':
## 
##     geom_bar, geom_col, geom_jitter, geom_line, geom_path,
##     geom_step, scale_color_continuous, scale_color_discrete,
##     scale_color_gradient, scale_color_gradientn,
##     scale_colour_discrete, scale_colour_gradient,
##     scale_colour_gradientn, scale_colour_ordinal,
##     scale_fill_continuous, scale_fill_discrete,
##     scale_fill_gradient, scale_fill_gradientn, scale_fill_ordinal
#install.packages("ggalt")
library(ggtext)
max_lifts_final %>% 
  filter(year == 2019) %>% 
  ggplot() + 
  ggalt::geom_dumbbell(aes(y = lift,
                    x = female, xend = male),
                colour = "grey", size = 5,
                colour_x = "#D6604C", colour_xend = "#395B74") +
  labs(y = element_blank(),
       x = "Top Lift Recorded (kg)",
       title =  "How <span style='color:#D6604C'>Women</span> and <span style='color:#395B74'>Men</span> Differ in Top Lifts",
       subtitle = "In 2019") +
  theme(plot.title = element_markdown(lineheight = 1.1, size = 20),
        plot.subtitle = element_text(size = 15)) +
  scale_y_discrete(labels = c("Bench", "Deadlift", "Squat")) +
  drop_axis(axis = "y") +
  geom_text(aes(x = female, y = lift, label = paste(female, "kg")),
            color = "#D6604C", size = 4, vjust = -2) +
  geom_text(aes(x = male, y = lift, label = paste(male, "kg")),
            color = "#395B74", size = 4, vjust = -2) +
  geom_rect(aes(xmin=430, xmax=470, ymin=-Inf, ymax=Inf), fill="grey80") +
  geom_text(aes(label=diff, y=lift, x=450), fontface="bold", size=4) +
  geom_text(aes(x=450, y=3, label="Difference"),
                     color="grey20", size=4, vjust=-3, fontface="bold")
## Registered S3 methods overwritten by 'ggalt':
##   method                  from   
##   grid.draw.absoluteGrob  ggplot2
##   grobHeight.absoluteGrob ggplot2
##   grobWidth.absoluteGrob  ggplot2
##   grobX.absoluteGrob      ggplot2
##   grobY.absoluteGrob      ggplot2

#Column {data-width=650} #————————————-

Add animation

#install.packages('gganimate')
#install.packages("gifski")
library(gganimate)
library(gifski)
animation <- max_lifts_final %>% 
  ggplot() + 
  ggalt::geom_dumbbell(aes(y = lift,
                    x = female, xend = male),
                colour = "grey", size = 5,
                colour_x = "#D6604C", colour_xend = "#395B74") +
  labs(y = element_blank(),
       x = "Top Lift Recorded (kg)",
       title =  "How <span style='color:#D6604C'>Women</span> and <span style='color:#395B74'>Men</span> Differ in Top Lifts",
       subtitle='\nThis plot depicts the difference between the heaviest lifts for each sex at International Powerlifting Federation\nevents over time. \n \n{closest_state}') +
  theme(plot.title = element_markdown(lineheight = 1.1, size = 25, margin=margin(0,0,0,0)),
        plot.subtitle = element_text(size = 15, margin=margin(8,0,-30,0))) +
  scale_y_discrete(labels = c("Bench", "Deadlift", "Squat")) +
  drop_axis(axis = "y") +
  geom_text(aes(x = female, y = lift, label = paste(female, "kg")),
            color = "#D6604C", size = 4, vjust = -2) +
  geom_text(aes(x = male, y = lift, label = paste(male, "kg")),
            color = "#395B74", size = 4, vjust = -2) +
  transition_states(year, transition_length = 4, state_length = 1) +
  ease_aes('cubic-in-out')

a_gif <- animate(animation, 
                 fps = 10, 
                 duration = 25,
        width = 800, height = 400, 
        renderer = gifski_renderer("./heavy_lifts_each_sex.gif"))

a_gif

#Column

Add animation

animation2 <- max_lifts_final %>% 
  ungroup %>% 
  mutate(lift = case_when(lift == "best3bench_kg" ~ "Bench",
                          lift == "best3squat_kg" ~ "Squat",
                          lift == "best3deadlift_kg" ~ "Deadlift")) %>% 
  ggplot(aes(year, diff, group = lift, color = lift)) + 
  geom_line(show.legend = FALSE) + 
  geom_segment(aes(xend = 2019.1, yend = diff), linetype = 2, colour = 'grey', show.legend = FALSE) + 
  geom_point(size = 2, show.legend = FALSE) + 
  geom_text(aes(x = 2019.1, label = lift, color = "#000000"), hjust = 0, show.legend = FALSE) + 
  drop_axis(axis = "y") +
  transition_reveal(year) +
  coord_cartesian(clip = 'off') +
  theme(plot.title = element_text(size = 20)) +
  labs(title = 'Difference over time',
       y = 'Difference (kg)',
       x = element_blank()) + 
  theme(plot.margin = margin(5.5, 40, 5.5, 5.5))

b_gif <- animate(animation2, 
                 fps = 10, 
                 duration = 25,
        width = 800, height = 200, 
        renderer = gifski_renderer("./difference_over_time.gif"))

b_gif

Combine animation: engine crashing-code commented below TBD

#install.packages("magick")
#library(magick)
#a_mgif <- image_read(a_gif)
#b_mgif <- image_read(b_gif)

#new_gif <- image_append(c(a_mgif[1], b_mgif[1]), stack = TRUE)
#for(i in 2:250){
 # combined <- image_append(c(a_mgif[i], b_mgif[i]), stack = TRUE)
  #new_gif <- c(new_gif, combined)
#}

#new_gif

RamyaP visuals:

#install.packages("ggridges")
library(gganimate)
library(gifski)
library(ggridges)
## 
## Attaching package: 'ggridges'
## The following object is masked from 'package:ggplot2':
## 
##     scale_discrete_manual
ipf_lifts_year <- ipf_lifts %>% 
                  mutate(year = format(date, "%Y")) %>%
                  filter(year %in% c(2009:2019))

ipf_lifts_decade<- ggplot(data=ipf_lifts_year, mapping = aes(x=best3squat_kg, y=year, fill=sex)) + 
geom_density_ridges() + 
scale_fill_manual(values = colorspace::darken(c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#999999")), labels = c("female", "male")) +
scale_color_manual(values = colorspace::darken(c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#999999"), 0.3))+
labs(x =    "Weight (kg)",y = "Year",title = "Squat") +
scale_x_continuous(limits = c(10,500)) + theme_ridges()+ transition_manual(year)

my_gif <- animate(ipf_lifts_decade, 
                 fps = 5, 
                 duration = 10,
        width = 800, height = 200, 
        renderer = gifski_renderer("./ipf_lifts_decade.gif"))
## Picking joint bandwidth of 14.1
## Warning: Removed 7332 rows containing non-finite values
## (stat_density_ridges).
## nframes and fps adjusted to match transition
my_gif